    Baraj ziua 4 (Selectie lot IOI, Cluj, mai 1996)
    Problema 11 (Bilete de autobuz)

     Se consider[ un bilet de autobuz n care zona perforat[ are n*n p[tr[ele i pe care se vor face
k perforaii. Dac[ biletul este introdus n aparatul de compostat cu partea imprimat[, vom spune c[ s-a
folosit faa. In caz contrar vom spune c[ s-a folosit dosul. Biletul nu se poate introduce n aparat dect
cu faa sau cu dosul, deoarece pe una din p[ri este prins de cotor. Dac[ un bilet a fost compostat pe dos,
perforaiile obinute formeaz[ configuraia "oglind[" a unei configuraii obinute prin compostare pe fa[.
    Pentru n i k date, s[ se genereze toate configuraiile astfel nct o configuraie care se genereaz[
s[ nu fie oglinda nici unei configuraii deja generate. (Prin aceasta se urm[rete ca la un eventual control
s[ se poat[ stabili f[r[ ambiguitate dac[ biletul respectiv a fost sau nu compostat ntr-o anumit[ zi n
care a fost valabil[ o anumit[ configuraie sau oglinda sa, indiferent dac[ s-a folosit la compostare faa
sau dosul biletului).
Date de intrare:
    Valorile lui n(2n9) i k(1k4) se vor introduce de la tastatur[.
Date de ieire:
    Intr-un fiier text al c[rui nume se va citi de la tastatur[, se va scrie pe fiecare linie o configuraie
sub forma:
i1j1i2j2..ikjk
unde: ipjp(p=1,k) sunt coordonatele perforaiilor, ip reprezint[ linia, jp reprezint[ coloana.
    Configuraiile trebuie scrise n fiierul de ieire n ordine lexicografic[.
Exemplu:
Pentur n=3 i k=2 coninutul fiierului de ieire va fi:
1112
1113
1121
1122
1123
1131
1132
1133
1221
1222
1231
1232
2122
2123
2131
2132
2133
2231
2232
3132
3133
Not[: Timp maxim de executare: 1 minut;
    Punctaj maxim: 100 puncte.
=================================================
Solutia 1 (Mihai Badoiu):
{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y-}
{$M 65520,0,655360}
var
    buf:array[1..60000] of char;
    v:array[1..4] of record
                                   y,x:integer;
             end;
    n,k:integer;
    fo:text;

procedure load;
var
    nume:string;
begin
    write('n = ');
    readln(n);
    write('k = ');
    readln(k);
    write('fisier iesire = ');
    readln(nume);
    assign(fo,nume);
    rewrite(fo);
    SetTextBuf(fo, buf);
end;

function compara:boolean;
var
    i,j:integer;
    x:array[1..5] of record
             y,x:integer;
             end;
begin
    for i:=1 to k do
    begin
             x[i].y:=v[i].y;
             x[i].x:=n-v[i].x+1;
             end;
    for i:=1 to k do
             for j:=i+1 to k do
             if (x[i].y=x[j].y) and (x[i].x>x[j].x) then
             begin
                           x[5]:=x[i];
                           x[i]:=x[j];
                           x[j]:=x[5];
                           end;
    for i:=1 to k do
    begin
             if (v[i].y=x[i].y) then
             begin
                           if (v[i].x>x[i].x) then
                           begin
                                              compara:=false;
                                              exit;
                                              end;
                           if (v[i].x<x[i].x) then
                                                                                          break;
                           end;
             end;
    compara:=true;
end;

procedure scs;
var
    i:integer;
begin
    if compara then
    begin
             for i:=1 to k do
                           write(fo,v[i].y,v[i].x);
             writeln(fo);
             end;
end;

procedure bk(p:integer;y,x:integer);
begin
    if p>k then
             scs
    else
    begin
             for y:=y to n do
             begin
                           for x:=x to n do
                           begin
                                              v[p].y:=y;
                                              v[p].x:=x;
                                              bk(p+1,y,x+1);
                                              end;
                           x:=1;
                           end;
             end;
end;

procedure calcul;
begin
    bk(1,1,1);
end;

procedure scrie;
begin
end;

begin
    load;
    calcul;
    close(fo);
end.
------------------------------------
Solutia 2 (Catalin Francu):
program BileteDeAutobuz;
{$B-,I-,R-,S-}
type Matrix=array[1..9,1..9] of Integer;
     Vector=array[1..4] of record
                             X,Y:Integer;
                           end;
     PVec=^Vector;
     PVector=array[1..3000] of PVec;
var A:Matrix;
    B:array[1..60000] of Byte;
    P:^PVector;
    V:Vector;
    N,K,PV:Integer;
    NS:LongInt;
    SO:String;

procedure Distrib(L,P:Integer;B:Boolean); forward;

procedure ReadData;
var i,j:Integer;
begin
  Write('N=');ReadLn(N);
  Write('K=');ReadLn(K);
  Write('Numele fisierului de iesire: ');ReadLn(SO);
  for i:=1 to N do
    for j:=1 to N do A[i,j]:=0;
  PV:=0;
  NS:=0;
  New(P);
end;

procedure PushPiece(L,C:Integer);
begin
  Inc(PV);
  A[L,C]:=1;
  V[PV].X:=L;
  V[PV].Y:=C;
end;

function LineOk(L:Integer):Integer;
var i,X,Y:Integer;
begin
  X:=0;Y:=0;
  for i:=1 to N do
    if A[L,i]=1 then
    begin
      Inc(X,1 shl (N-i));
      Inc(Y,1 shl (i-1));
    end;
  if X=Y then LineOk:=0
         else if X>Y then LineOk:=1
                     else LineOk:=-1;
end;

procedure GetPiece;
begin
  A[V[PV].X,V[PV].Y]:=0;
  Dec(PV);
end;

procedure Comb(L,P,K,Level,Max:Integer;B:Boolean);
var i:Integer;
begin
  if Level=K+1 then case LineOk(L) of
                      0:Distrib(L+1,P-K,B);
                      1:Distrib(L+1,P-K,True);
                      -1: if B then Distrib(L+1,P-K,True);
                    end {case}
               else for i:=Max+1 to N+Level-K do
                      begin
                        PushPiece(L,i);
                        Comb(L,P,K,Level+1,i,B);
                        GetPiece;
                      end;
end;

procedure PlacePieces(L,P,K:Integer;B:Boolean);
begin
  Comb(L,P,K,1,0,B);
end;

function Smaller(var V1,V2:Vector):Boolean;
var i:Integer;
begin
  i:=0;
  repeat Inc(i);
  until (i=k) or (V1[i].X<>V2[i].X) or (V1[i].Y<>V2[i].Y);
  Smaller:=(V1[i].X<V2[i].X) or ((V1[i].X=V2[i].X) and (V1[i].Y<V2[i].Y));
end;

procedure SortSol;
var i,j,k:Integer;
    PAux:PVec;
begin
  for i:=1 to NS-1 do
    begin
      k:=i;
      for j:=i+1 to NS do
        if Smaller(P^[j]^,P^[k]^) then k:=j;
      PAux:=P^[k];P^[k]:=P^[i];P^[i]:=PAux;
    end;
end;

procedure WriteSolution;
var i,j:Integer;
begin
  Inc(NS);
  if NS<=3000 then begin
                     New(P^[NS]);
                     P^[NS]^:=V;
                     if NS=3000 then begin
                                        SortSol;
                                        for i:=1 to 3000 do
                                          begin
                                            for j:=1 to K do
                                              Write(P^[i]^[j].X,P^[i]^[j].Y);
                                            WriteLn;
                                          end;
                                      end;
                   end
  else begin
    for i:=1 to K do
    Write(V[i].X,V[i].Y);
  WriteLn;
  end;
end;

procedure Flush;
var i,j:Integer;
begin
  SortSol;
  for i:=1 to NS do
    begin
      for j:=1 to K do
        Write(P^[i]^[j].X,P^[i]^[j].Y);
      WriteLn;
    end;
end;

procedure Distrib(L,P:Integer;B:Boolean);
var i:Integer;
begin
  if P=0 then WriteSolution
         else
  if (N-L+1)*N>=P
    then for i:=0 to P do PlacePieces(L,P,i,B);
end;
begin
  ReadData;
  Assign(Output,SO);
  SetTextBuf(Output,B,60000);
  Rewrite(Output);
  Distrib(1,K,False);
  if NS<3000 then Flush;
  Close(Output);
end.
--------------------------------------
Solutia 3 (Ovidiu Ghiorghioiu):
{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,655360}
const nmax=9;
      kmax=4;
      bsize=60416;
var x,y:array[0..kmax] of byte;
    o:array[1..nmax,1..nmax] of boolean;
    k,n:byte;
    t:byte;
    f:file;
    s:string;
    b:array[0..bsize-1] of byte;
    bp:word;
procedure putb(w:byte);
begin
     b[bp]:=w;
     inc(bp);
     if bp=bsize then begin
        blockwrite(f,b,bsize);
        if ioresult<>0 then begin
           writeln('Eroare in scrierea fisierului.');
           halt
        end;
        bp:=0
     end;
end;
procedure back(l:byte);
var i,j,mi,mj:byte;
    st:byte;
begin
     if l=k+1 then begin
        for i:=1 to k do begin
            putb(x[i]+48);
            putb(y[i]+48);
        end;
        putb(13);
        putb(10);
     end else begin
         i:=x[l-1];
         j:=y[l-1];
         mi:=n-(k-l) div n;
         mj:=n-(k-l) mod n;
         st:=t;
         while (i<mi) or (j<mj) do begin
               if j=n then begin
                  j:=1;
                  inc(i)
               end else inc(j);
               if (t>0) or (j<=n-j+1) then begin
                  if (j<n-j+1) then inc(t) else
                     if o[i,n-j+1] then dec(t);
                  x[l]:=i;
                  y[l]:=j;
                  o[i,j]:=true;
                  back(l+1);
                  o[i,j]:=false;
                  t:=st;
               end;
         end;
     end;
end;
begin
     write('n=');readln(n);
     write('k=');readln(k);
     write('Numele fis. de iesire: ');readln(s);
     assign(f,s);
     rewrite(f,1);
     if ioresult<>0 then begin
        writeln('Eroare la deschiderea fisierului.');
        halt
     end;
     fillchar(o,sizeof(o),false);
     t:=0;
     x[0]:=1;y[0]:=0;
     back(1);
     blockwrite(f,b,bp);
     if ioresult<>0 then begin
        writeln('Eroare in scrierea fisierului.');
        halt
     end;
     close(f);
end.
--------------------------------
